package Config::System::Property;

use Moose;
use Moose::Util::TypeConstraints;

subtype PerlIdentifier
    => as 'Str'
    => where { /^[_a-zA-Z][\w:]*$/ };

type Constraint
    => where { $_->isa('Moose::Meta::TypeConstraint') };

coerce Constraint 
    => from 'Str'
    => via { find_type_constraint($_) };

enum PropertyState => qw(
    NEVER_BEEN_SET
    IS_STATIC
    IS_EXPRESSION
    HAS_BEEN_COMPUTED
);

# public state - compile time
has name        => (is => 'ro', isa => 'PerlIdentifier', required => 1);
has section     => (is => 'ro', isa => 'Str', required => 1);
has default     => (is => 'ro', isa => 'Any');
has has_default => (is => 'rw', isa => 'Bool');
has is_memoized => (is => 'rw', isa => 'Bool', required => 1, default => 0);
has constraint  => ( # known in constructor as "isa", but can't have such a method!
    is          => 'rw',
    isa         => 'Constraint',
    required    => 1,
    coerce      => 1,
    default     => sub { find_type_constraint('Any') },
);

# public state - runtime
has value       => (is => 'rw', isa => 'Any');
has expression  => (is => 'rw', isa => 'Str');

# internal state 
has compiled    => (is => 'rw', isa => 'CodeRef'); # the compiled expression as a code ref
has state       => (is => 'rw', isa => 'PropertyState', default => 'NEVER_BEEN_SET');

# public -----------------------------------------------------------------------

sub BUILD {
    my ($self, $args) = @_;
    $self->constraint($args->{isa} || 'Any'); # can't have "isa" as attribute name
    $self->has_default(1) if exists $args->{default};
}

sub set {
    my ($self, $value) = @_;
    $self->validate_value($value);
    $self->state('IS_STATIC');
    $self->expression(undef);
    $self->compiled(undef);
    $self->value($value);
}

sub set_if_1st {
    my ($self, $value) = @_;
    return unless $self->NEVER_BEEN_SET;
    $self->set($value);
}

sub set_expression {
    my ($self, $expression) = @_;
    $self->state('IS_EXPRESSION');
    $self->compiled(undef);
    $self->expression($expression);
}

sub set_expression_if_1st {
    my ($self, $expression) = @_;
    return unless $self->NEVER_BEEN_SET;
    $self->set_expression($expression);
}

sub get {
    my $self = shift;
    return $self->default if $self->NEVER_BEEN_SET && $self->has_default;

    die "Can't get property [". $self->name. "] because it has not been set yet"
        if $self->NEVER_BEEN_SET;

    return 
        $self->IS_STATIC                               ? $self->value:
        $self->is_memoized && $self->HAS_BEEN_COMPUTED ? $self->value:
        $self->is_memoized                             ? $self->memoize_value:
        $self->compute_value;
}

sub clone {
    my $self = shift;
    local $_;
    my $clone = ref($self)->new(
        map { ($_ => $self->$_) } qw(
            name
            section
            is_memoized
        ),
        ( $self->has_default? (default => $self->default): () ),
    );
    $clone->constraint( $self->constraint ); # to avoid coercion Moose bug
    unless ($self->NEVER_BEEN_SET) {
        if ($self->IS_STATIC)
           { $clone->set($self->get) }
        elsif ($self->IS_EXPRESSION || $self->HAS_BEEN_COMPUTED)
            { $clone->set_expression($self->expression) }
        # TODO maybe clone value if memoized?
    }
    return $clone;
}

# private ----------------------------------------------------------------------

sub memoize_value {
    my $self = shift;
    my $value = $self->compute_value;
    $self->value($value);
    return $value;
}

sub compute_value {
    my $self = shift;
    $self->compiled($self->compile_expression)
        unless $self->compiled;
    my $value = eval { $self->compiled->() };
    die "Can't compute value for [". $self->name. "] from expression [". $self->expression. "] because $@"
        if $@;
    $self->validate_value($value);
    $self->state('HAS_BEEN_COMPUTED');
    return $value;
}
 
sub compile_expression {
    my $self = shift;
    my $code = eval(
        'sub { package '. $self->section. ';use strict; use warnings; return '.
        $self->expression. "\n}"
    );
    die "Can't compile expression for property [". $self->name. "] because: $@"
        if $@;
    return $code;
}

sub validate_value {
    my ($self, $value) = @_;
    die
        "Can't set property [". $self->name.
        "] to [$value] because it fails constraint [". $self->constraint->name. "]"
        unless $self->constraint->check($value);
}

sub NEVER_BEEN_SET    { shift->state eq 'NEVER_BEEN_SET'    }
sub IS_STATIC         { shift->state eq 'IS_STATIC'         }
sub IS_EXPRESSION     { shift->state eq 'IS_EXPRESSION'     }
sub HAS_BEEN_COMPUTED { shift->state eq 'HAS_BEEN_COMPUTED' }

1;



